home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / database / tickle15.zip / EDITOR.PPS < prev    next >
Text File  |  1996-08-02  |  25KB  |  950 lines
  1. ;
  2. ;  EDITOR.PPS - Program to access TICKLE.DBF and edit information
  3. ;
  4. ;  Written by Dan Shore
  5. ;
  6. ;==========================================================================
  7. '
  8. '  Declare our variables
  9. '
  10. STRING dbfields(49), file_name, pcbtext_number, main_prompt
  11. STRING user_input, pcb_user_name, field_name, next_file_entry
  12. STRING hold, hold2, desc_hold, flag_list, reg_code, tkl_cfg
  13. STRING user_input2, stack_var, temp_var, tkltext, cname_file
  14. STRING dlpath_lst, first_letter, dlpath_lst_entry, back_space
  15. STRING ndx_file_name, file_root, file_ext, user_input3
  16. STRING char1, char2, char3, char4, current_char
  17.  
  18. INT cmd_line_count, filenames_used, next_flag_file
  19. INT count, x, i, hold_num, start, end, line_count
  20. INT temp_int, letter_value, cname_size, dot_number
  21. INT alpha, index_start, index_end, current_record
  22. INT low_record, high_record
  23.  
  24. LONG file_size, ndx_size, seek_record, value, y
  25. FLOAT high_num, low_num, rec_num, time_now, prev_ti
  26.  
  27. BOOLEAN menu_displayed, did_list, did_delete, did_reorg
  28. BOOLEAN start_flag, did_flag, did_help, edit_description
  29. BOOLEAN do_menu, find_user, found_user, partial_name, exact_name
  30. BOOLEAN list_names, partial_search_found, cfg_file_exist
  31. BOOLEAN file_exists, done, is_key, non_stop
  32.  
  33. :MAIN_BEGIN
  34.    '  Open the database file and index files.
  35.    '
  36.    find_user = TRUE
  37.    do_menu = TRUE
  38.    tkltext = PPEPATH() + "TKLTEXT" + LANGEXT()
  39.  
  40.    char1 = "\"
  41.    char2 = "|"
  42.    char3 = "/"
  43.    char4 = "-"
  44.    back_space = CHR(8) + CHR(32) + CHR(8)
  45.  
  46.    GOSUB OPEN_DATABASE
  47.    IF (DERR(0)) THEN
  48.      NEWLINE
  49.      PRINTLN READLINE (tkltext,2)
  50.      NEWLINE
  51.      PRINTLN READLINE (tkltext,3)
  52.      NEWLINE
  53.      LOG "Cannot open TICKLE.DBF (DataBase) - Aborting", FALSE
  54.      GOTO EXIT_PROG
  55.    END IF
  56.  
  57.    GOSUB OPEN_INDEX
  58.    IF (DERR(0)) THEN
  59.      NEWLINE
  60.      PRINTLN READLINE (tkltext,4)
  61.      NEWLINE
  62.      PRINTLN READLINE (tkltext,3)
  63.      NEWLINE
  64.      LOG "Cannot open TICKLE.NDX (Index) - Aborting", FALSE
  65.      GOTO EXIT_PROG
  66.    END IF
  67.  
  68.    CLS
  69.    NEWLINE
  70.    PRINTLN READLINE (tkltext,41)
  71.    GOSUB EDIT_FIND_USER
  72.  
  73.    GOSUB MENU
  74.    GOTO EXIT_PROG
  75.  
  76. :MAIN_END
  77. '
  78. '====================================
  79. '|                                  |
  80. '|  Subroutines used in EDITOR.PPE  |
  81. '|                                  |
  82. '====================================
  83. '
  84. '
  85. '
  86. :CHECK_NUMBER_RANGE
  87.  
  88.    IF (INSTR(user_input,"-") = 0 || INSTR(user_input,"-") = 1) RETURN
  89.    stack_var = user_input
  90.    user_input = ""
  91.    TOKENIZE stack_var
  92.    IF (TOKCOUNT() = 0) RETURN
  93.    FOR hold_num = 1 TO LEN(stack_var)
  94.      temp_var = GETTOKEN()
  95.      IF (temp_var = "") BREAK
  96.      IF (INSTR(temp_var, "-") = 0) THEN
  97.        user_input = user_input + temp_var + " "
  98.      ELSE
  99.        hold = MID(temp_var, 1, INSTR(temp_var,"-")-1)
  100.        IF (hold != "") hold2 = MID(temp_var, INSTR(temp_var,"-")+1, LEN(temp_var))
  101.        start = S2I(hold,10)
  102.        end = S2I(hold2,10)
  103.        IF (start < 1) THEN
  104.          IF (start = 0) hold = temp_var
  105.          NEWLINE
  106.          PRINTLN READLINE (tkltext,26), hold, READLINE (tkltext,27)
  107.          NEWLINE
  108.          CONTINUE
  109.        END IF
  110.        IF (end > 24) THEN
  111.          NEWLINE
  112.          PRINTLN READLINE (tkltext,26), end, READLINE (tkltext,27)
  113.          NEWLINE
  114.          CONTINUE
  115.        END IF
  116.        IF (end >= start) THEN
  117.          FOR count = start TO end
  118.            user_input = user_input + LTRIM(I2S(count,10)," ") + " "
  119.          NEXT
  120.        ELSE
  121.          NEWLINE
  122.          PRINTLN READLINE (tkltext,5), temp_var, READLINE (tkltext,6)
  123.        END IF
  124.      END IF
  125.    NEXT
  126.    RETURN
  127. '
  128. '
  129. '
  130. :FIND_EMPTY_SLOT
  131.  
  132.    filenames_used = 0
  133.    FOR i = 2 TO 25
  134.      IF (DGET(0,DNAME(0,i)) = "            ") THEN
  135.        filenames_used = i-1
  136.        BREAK
  137.      END IF
  138.    NEXT
  139.    RETURN
  140.  
  141. '
  142. '
  143. '
  144. :SEQ_DISP_USER
  145.  
  146.    is_key = FALSE
  147.    IF (DTOP(0) = FALSE) THEN
  148.      NEWLINE
  149.      SPRINTLN READLINE (tkltext,42)
  150.      NEWLINE
  151.      WAIT
  152.      GOTO EXIT_PROG
  153.    ELSE
  154.      IF (!list_names) PRINT "  @X0ESearching @X0F[@X0CENTER Aborts@X0F] @X0F...  @X0E"
  155.      FOR x = 1 to DRECCOUNT(0)
  156.        DGO 0, x
  157.        hold = TRIM(DGET(0, DNAME(0,1))," ")
  158.        IF (!list_names) THEN
  159.          GOSUB MARKTIME
  160.          IF (INSTR(hold, user_input) > 0) THEN
  161.            PRINT back_space
  162.            partial_search_found = TRUE
  163.            NEWLINE
  164.            PRINTLN READLINE (tkltext,43), hold
  165.            NEWLINE
  166.            user_input2 = "N"
  167.            main_prompt = READLINE (tkltext,44)
  168.            INPUTSTR main_prompt, user_input2, @X0E, 1, "YN", UPCASE+LFAFTER
  169.            IF (user_input2 = "" || user_input2 = "N" || user_input2 = NOCHAR()) THEN
  170.              found_user = TRUE
  171.              BREAK
  172.            ELSE
  173.              NEWLINE
  174.              PRINT "  @X0ESearching @X0F[@X0CENTER Aborts@X0F] @X0F...  @X0E"
  175.            END IF
  176.          ELSE
  177.            GOSUB CHECK_FOR_KEY
  178.            IF (is_key) BREAK
  179.          END IF
  180.        ELSE
  181.          '
  182.          '  Print out number and username
  183.          '
  184.          PRINT SPACE (5-LEN(STRING(x))), "@X0F", x, ". @X03", hold
  185.          IF (!(x%2)) THEN
  186.            NEWLINE
  187.            INC line_count
  188.          ELSE
  189.            PRINT SPACE(33-LEN(hold))
  190.          END IF
  191.  
  192.          '
  193.          '  If non-stop mode, check for abort (enter key)
  194.          '
  195.          IF (non_stop) THEN
  196.            GOSUB CHECK_FOR_KEY
  197.            IF (is_key) THEN
  198.              non_stop = FALSE
  199.              BREAK
  200.            END IF
  201.          END IF
  202.  
  203.          IF (line_count > 21 && !non_stop) THEN
  204.            main_prompt = READLINE (tkltext,45)
  205.            user_input2 = "Y"
  206.            INPUTSTR main_prompt, user_input2, @X0E, 2, "YNS", UPCASE+ERASELINE
  207.            IF (user_input2 = "N" || user_input2 = NOCHAR()) THEN
  208.              BREAK
  209.            ELSE IF (user_input2 = "NS") THEN
  210.              NEWLINE
  211.              PRINTLN "           @X0E*** @X4FHit ENTER to@X1F Abort Non-Stop Listing@X0E ***"
  212.              DELAY 18
  213.              NEWLINE
  214.              non_stop = TRUE
  215.            ELSE
  216.              line_count = 0
  217.            END IF
  218.          END IF
  219.        END IF
  220.      NEXT
  221.      IF (!found_user) DGO 0, 1
  222.      PRINT back_space
  223.      NEWLINE
  224.    END IF
  225.    RETURN
  226.  
  227. '
  228. '  Subroutine to find/add username in index
  229. '
  230. :FIND_ADD_USER
  231.    '
  232.    '  Get the current users name
  233.    '
  234.    DSEEK 0, pcb_user_name
  235.    IF (DCHKSTAT(0) = 0) THEN
  236.      NEWLINE
  237.      PRINTLN READLINE (tkltext,46)
  238.      NEWLINE
  239.      GOSUB FIND_EMPTY_SLOT
  240.    ELSE
  241.      NEWLINE
  242.      PRINTLN READLINE (tkltext,47)
  243.      NEWLINE
  244.      DELAY 18
  245.      filenames_used = 32000
  246.    END IF
  247.    RETURN
  248. '
  249. '
  250. '
  251. :DISPLAY_INFO
  252.  
  253.    DISPFILE PPEPATH() + "info", GRAPH+LANG
  254.    menu_displayed = TRUE
  255.    RETURN
  256. '
  257. '
  258. '
  259. :DISPLAY_HELP
  260.  
  261.    NEWLINE
  262.    DISPFILE PPEPATH() + "help", GRAPH+LANG
  263.    did_help = TRUE
  264.    RETURN
  265. '
  266. '
  267. '
  268. :EDIT_DESC
  269.  
  270.    IF (!did_list) THEN
  271.      GOSUB LIST_FILES
  272.      did_list = TRUE
  273.    ELSE
  274.      NEWLINE
  275.    END IF
  276.    user_input = ""
  277.    main_prompt = READLINE (tkltext,8)
  278.    INPUTSTR main_prompt, user_input, @X0E, 2, MASK_ASCII(), LFAFTER+UPCASE
  279.    IF (user_input = "") THEN
  280.      NEWLINE
  281.      RETURN
  282.    END IF
  283.    hold_num = S2I(user_input,10)
  284.    user_input = STRING(hold_num)
  285.    IF (hold_num > 24 || hold_num < 1) THEN
  286.      NEWLINE
  287.      PRINTLN READLINE (tkltext,9)
  288.      NEWLINE
  289.      RETURN
  290.    ELSE
  291.      desc_hold = "desc" + TRIM(user_input," ")
  292.      hold = "file" + TRIM(user_input," ")
  293.    END IF
  294.    IF (DGET(0,hold) != "            ") THEN
  295.      edit_description = TRUE
  296.      GOSUB ASK_FILE_DESC
  297.      edit_description = FALSE
  298.    ELSE
  299.      NEWLINE
  300.      PRINTLN READLINE (tkltext,58)
  301.    END IF
  302.    NEWLINE
  303.    RETURN
  304.  
  305. '
  306. '
  307. '
  308. :EDIT_FIND_USER
  309.  
  310.    found_user = FALSE
  311.    partial_name = FALSE
  312.    exact_name = FALSE
  313.    list_names = FALSE
  314.    partial_search_found = FALSE
  315.    user_input = ""
  316.    DISPFILE PPEPATH()+"USRMENU", GRAPH+LANG
  317.    main_prompt = READLINE (tkltext,48)
  318.    INPUTSTR main_prompt, user_input, @X0E, 1, MASK_ALPHA(), LFAFTER+UPCASE+GUIDE+FIELDLEN
  319.    SELECT CASE (user_input)
  320.      CASE "A"
  321.        partial_name = TRUE
  322.      CASE "B"
  323.        exact_name